Flame Graph
Data
Options ▾
C:\Eliot\GitHub\NetLogoR/R/turtle-functions.RMemoryTime
standardGeneric("fd")
turtles@data$prevX <- prevXcor
turtles@data$prevY <- prevYcor
fdXcor <- prevXcor + sin(rad(turtles@data$heading)) * dist
fdYcor <- prevYcor + cos(rad(turtles@data$heading)) * dist
if(torus == TRUE){
if(missing(world)){
tCoords <- wrap(cbind(x = fdXcor, y = fdYcor), extent(world))
turtles@coords <- cbind(xcor = round(fdXcor, digits = 5), ycor = round(fdYcor, digits = 5))
function(turtles, who) {
standardGeneric("die")
whoTurtles <- turtles@data$who
toSelect <- whoTurtles[which(!whoTurtles %in% who)]
newTurtles <- turtle(turtles, toSelect)
standardGeneric("hatch")
iTurtle <- match(who, turtles@data$who)
parentData <- turtles@data[iTurtle,]
newCoords <- rbind(turtles@coords, cbind(xcor = rep(as.numeric(parentCoords[,1]), each = n), ycor = rep(as.numeric(parentCoords[,2]), each = n)))
newData <- rbind(turtles@data, parentData[rep(seq_len(nrow(parentData)), each = n),])
rownames(newData) <- seq_len(nrow(newData))
newData[(nrow(turtles) + 1):nrow(newData), "who"] <- (max(turtles@data$who) + 1):(max(turtles@data$who) + (n * length(iTurtle)))
newTurtles <- SpatialPointsDataFrame(coords = newCoords, data = newData)
function(turtles, angle) {
standardGeneric("left")
newHeading <- turtles@data$heading - angle
newHeading[newHeading < 0] <- newHeading[newHeading < 0] + 360
newHeading[newHeading >= 360] <- newHeading[newHeading >= 360] - 360
turtles@data$heading <- newHeading
standardGeneric("right")
left(turtles = turtles, angle = -angle)
standardGeneric("patchHere")
pTurtles <- patch(world = world, x = turtles@coords[,1], y = turtles@coords[,2], duplicate = TRUE, out = TRUE)
standardGeneric("turtle")
newTurtles <- turtles[turtles$who %in% who, ]
if(!identical(newTurtles@data$who, who)){
iTurtles <- match(who, newTurtles@data$who)
newTurtles@coords <- cbind(xcor = newTurtles@coords[iTurtles,1], ycor = newTurtles@coords[iTurtles,2])
newTurtles@data <- newTurtles@data[iTurtles,]
standardGeneric("turtlesOn")
pTurtles <- patchHere(world = world, turtles = turtles) # patches where the turtles are
pTurtles <- cbind(pTurtles, who = turtles@data$who)
if(simplify == TRUE){
pOn <- merge(agents, pTurtles) # patches where the turtles are among the agents patches
turtle(turtles = turtles, who = pOn[,3])
agents <- cbind(agents, id = 1:nrow(agents))
pOn <- merge(agents, pTurtles) # patches where the turtles are among the agents patches
pOn <- pOn[order(pOn[,"id"]),]
turtlesID <- cbind(whoTurtles = pOn[,"who"], id = pOn[,"id"])
turtlesOn(world = world, turtles = turtles, agents = patchHere(world = world, turtles = agents), simplify = simplify)
function(world, agents, var) {
standardGeneric("of")
if(length(var) == 1){
if(var == "xcor"){
return(agents@data[,var])
if(any(var == "xcor" | var == "ycor")){
agentsData <- cbind(agents@coords, agents@data)
return(agentsData[,var])
agents@data[,var]
valuesW <- values(world)
if(identical(patches(world), agents)){
cells <- cellFromPxcorPycor(world = world, pxcor = agents[,1], pycor = agents[,2])
return(valuesW[cells, var])
/examples/Wolf-Sheep-Predation/Wolf-Sheep-Predation.RMemoryTime
turtles <- right(turtles, angle = runif(n = count(turtles), min = -50, max = 50))
turtles <- fd(world = grass, turtles = turtles, dist = 1, torus = TRUE)
eatGrass <- function(){ # only sheep
pGreen <- NLwith(world = field, var = "grass", agents = patches(field), val = 1) # patches with grass equal to 1 (green)
sheepOnGreen <- turtlesOn(world = field, turtles = sheep, agents = pGreen) # sheep on green patches
if(count(sheepOnGreen) != 0){
energySheep <- of(agents = sheepOnGreen, var = "energy") # energy before eating
sheep <- set(turtles = sheep, agents = sheepOnGreen, var = "energy", val = energySheep + gainFoodSheep) # update energy
pHere <- patchHere(world = field, turtles = sheepOnGreen)
field <- set(world = field, agents = pHere, var = "grass", val = 0)
whoEnergy <- of(agents = turtles, var = c("who", "energy"))
who0 <- whoEnergy[which(whoEnergy$energy < 0), "who"] # "who" numbers of the turtles with their energy value below 0
turtles <- die(turtles = turtles, who = who0)
repro <- runif(n = count(turtles), min = 0, max = 100) < reproTurtles
whoTurtles <- of(agents = turtles, var = "who") # "who" of the turtles before they reproduce
reproWho <- whoTurtles[repro] # "who" of turtles which reproduce
reproInd <- turtle(turtles, who = reproWho) # turtles which reproduce
if(count(reproInd) != 0){ # if there is at least one turtle reproducing
energyTurtles <- of(agents = reproInd, var = "energy")
turtles <- set(turtles = turtles, agents = reproInd, var = "energy", val = energyTurtles / 2)
turtles <- hatch(turtles = turtles, who = reproWho, n = 1) # hatch one offspring per parent
whoNewTurtles <- of(agents = turtles, var = "who") # "who" of the turtles after they reproduced
whoOffspring <- which(!whoNewTurtles %in% whoTurtles) # "who" of offspring
offspring <- turtle(turtles = turtles, who = whoOffspring)
offspringMoved <- right(turtles = offspring, angle = runif(n = count(offspring), min = 0, max = 360))
offspringMoved <- fd(world = grass, turtles = offspring, dist = 1, torus = TRUE)
valOffspring <- of(agents = offspringMoved, var = c("heading", "xcor", "ycor"))
turtles <- set(turtles = turtles, agents = offspring, var = c("heading", "xcor", "ycor"), val = valOffspring)
sheepWolves <- turtlesOn(world = grass, turtles = sheep, agents = wolves, simplify = FALSE)
if(nrow(sheepWolves) != 0){
sheepGrabbed <- oneOf(agents = sheepWolves) # grab one random sheep
sheep <- die(turtles = sheep, who = sheepGrabbed) # kill the grabbed sheep
whoWolves <- of(agents = wolves, var = "who")
whoGrabbingWolves <- whoWolves[unique(sheepWolves[,"id"])]
grabbingWolves <- turtle(turtles = wolves, who = whoGrabbingWolves)
energyGrabbingWolves <- of(agents = grabbingWolves, var = "energy")
wolves <- set(turtles = wolves, agents = grabbingWolves, var = "energy", val = energyGrabbingWolves + gainFoodWolf)
pBrown <- NLwith(world = field, var = "grass", agents = patches(field), val = 0)
pBrownCountdown <- of(world = field, var = "countdown", agents = pBrown) # countdown values for the patches equal to 0 (brown)
pBrownCountdown0 <- which(pBrownCountdown <= 0) # patches with a countdown <= 0
field <- set(world = field, var = c("grass", "countdown"), agents = pGrow,
pBrownCountdown1 <- which(!pBrownCountdown <= 0) # patches with a countdown > 0
pWait <- pBrown[pBrownCountdown1, ] # patches with grass equal to 0 (brown) and countdown > 0
field <- set(world = field, var = "countdown", agents = pWait, val = pBrownCountdown[pBrownCountdown1] - 1)
return(field)
while((NLany(sheep) | NLany(wolves)) & time < 500 ){ # as long as there are sheep or wolves in the world (time steps maximum at 500)
if(count(sheep) != 0){
sheep <- move(sheep)
if(grassOn == TRUE){
energySheep <- of(agents = sheep, var = "energy")
sheep <- set(turtles = sheep, agents = sheep, var = "energy", val = energySheep - 1)
eatGrassResults <- eatGrass() # in the results are stored both "field" and "sheep"
sheep <- death(sheep)
if(count(sheep) != 0){
sheep <- reproduce(sheep, reproSheep)
if(count(wolves) != 0){
wolves <- move(wolves)
energyWolves <- of(agents = wolves, var = "energy")
wolves <- set(turtles = wolves, agents = wolves, var = "energy", val = energyWolves - 1)
catchSheepResults <- catchSheep() # in the results are stored both "sheep" and "wolves"
wolves <- death(wolves)
if(count(wolves) != 0){
wolves <- reproduce(wolves, reproWolf)
field <- growGrass()
pGreen <- NLwith(world = field, var = "grass", agents = patches(field), val = 1) # patches equal to 1 (green)
npGreen <- count(pGreen)
numSheep <- c(numSheep, count(sheep)) # add the new number of sheep
numWolves <- c(numWolves, count(wolves)) # add the new numbr of wolves
C:\Eliot\GitHub\NetLogoR/R/agentset-functions.RMemoryTime
standardGeneric("NLany")
anyAgents <- ifelse(length(agents) == 0, FALSE, TRUE)
function(agents) {
standardGeneric("count")
return(nrow(agents))
return(length(agents))
standardGeneric("NLwith")
pxcor <- agents[,1]
pycor <- agents[,2]
values <- world[pxcor,pycor]
pVal <- which(values %in% val)
pxcorVal <- pxcor[pVal]
pycorVal <- pycor[pVal]
return(cbind(pxcor = pxcorVal, pycor = pycorVal))
names_l <- names(world)
l <- match(var, names_l)
world_l <- world[[l]]
NLwith(world = world_l, agents = agents, val = val)
standardGeneric("oneOf")
if(ncol(agents) == 2 & colnames(agents)[1] == "pxcor"){
whoTurtles <- tapply(X = agents[,"whoTurtles"], INDEX = as.factor(agents[, "id"]),
FUN = function(x){ifelse(length(x) == 1, x, sample(x, size = 1))})
function(world, turtles, agents, var, val) {
standardGeneric("set")
if(count(agents) != 0){
if(identical(patches(world), agents)){
valuesW <- values(world)
cells <- cellFromPxcorPycor(world = world, pxcor = agents[,1], pycor = agents[,2])
colNum <- match(var, colnames(valuesW))
valuesW[cells, colNum] <- val
world@layers[[colNum]][] <- valuesW[,colNum]
colNum <- match(var[i], colnames(valuesW))
valuesW[cells, colNum] <- val[,i]
world@layers[[colNum]][] <- valuesW[,colNum]
if(count(agents) != 0){
if(identical(agents, turtles)){
turtles@data[, var] <- val
iAgents <- row.match(agents@data, turtles@data) # using data.table is not faster
if(var == "xcor"){
turtles@data[iAgents, var] <- val
turtlesData <- cbind(turtles@coords, turtles@data)
turtles@coords <- cbind(xcor = turtlesData[,1], ycor = turtlesData[,2])
turtles@data <- turtlesData[,3:ncol(turtlesData)]
return(turtles)
C:\Eliot\GitHub\NetLogoR/R/world-functions.RMemoryTime
standardGeneric("maxPxcor")
world_l <- world[[1]]
maxPxcor(world = world_l)
standardGeneric("maxPycor")
world_l <- world[[1]]
maxPycor(world = world_l)
standardGeneric("minPxcor")
world_l <- world[[1]]
minPxcor(world = world_l)
standardGeneric("minPycor")
world_l <- world[[1]]
minPycor(world = world_l)
C:\Eliot\GitHub\NetLogoR/R/patch-functions.RMemoryTime
standardGeneric("patch")
pxcor_ <- round(x)
pycor_ <- round(y)
if(torus == TRUE){
pxcorNA <- ifelse(pxcor_ < minPxcor(world) | pxcor_ > maxPxcor(world), NA, pxcor_)
pycorNA <- ifelse(pycor_ < minPycor(world) | pycor_ > maxPycor(world), NA, pycor_)
pycorNA[is.na(pxcorNA)] <- NA
if(out == FALSE){
pCoords <- matrix(data = cbind(pxcor, pycor), ncol = 2, nrow = length(pxcor), dimnames = list(NULL, c("pxcor", "pycor")))
if(duplicate == FALSE){
function(world) {
standardGeneric("patches")
return(cbind(pxcor = world@pxcor, pycor = world@pycor))
world_l <- world[[1]]
patches(world = world_l)
C:\Eliot\GitHub\NetLogoR/R/NLworlds-class.RMemoryTime
cells <- which(x@pxcor %in% i & x@pycor %in% j, TRUE) # cell number(s)
xValues <- values(x)
cellValues <- xValues[cells]
standardGeneric("cellFromPxcorPycor")
cellNum <- cellFromXY(world, cbind(x = pxcor, y = pycor))
return(cellNum)
C:\Eliot\GitHub\SpaDES/R/neighbourhood.RMemoryTime
setGeneric("wrap", function(X, bounds, withHeading) {
standardGeneric("wrap")
if (identical(colnames(X), c("x", "y"))) {
return(cbind(
05,00010,00015,00020,00025,00030,000